home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / RAMSES 2.2 / RAMSES 2.2 / M2Lib / HighInOut.MOD < prev    next >
Encoding:
Modula Implementation  |  1996-06-21  |  10.9 KB  |  422 lines  |  [TEXT/MEDT]
  1. IMPLEMENTATION MODULE HighInOut ;
  2.  
  3.   (*
  4.  
  5.         Implementation and Revisions:
  6.         ============================
  7.  
  8.         Author  Date        Description
  9.         ------  ----        -----------
  10.  
  11.         af      21/09/90    First implementation (DM 2.01,
  12.                             MacMETH 2.6+)
  13.         af        02/10/90    curRP and curWP plus redirection
  14.                             mechanism added
  15.  
  16.   *)
  17.   
  18.   IMPORT Terminal; (* just for Read, Write, and WriteLn *)  
  19.   FROM Conversions IMPORT StringToReal, RealToFixString; 
  20.   (* is too complicated to implement here *)
  21.     
  22.   CONST
  23.     EOL     = 15C; (* Return on Mac *)
  24.     LF        = 12C;
  25.     
  26.     CAN     = 30C;
  27.     ESC     = 33C;
  28.     HELP      = "?";
  29.     BS      = 10C;
  30.     BEL        = 7C;
  31.     DEL     = 177C;  
  32.  
  33.   
  34.   VAR
  35.     RandomWriteDisplay: BOOLEAN;
  36.     curGiveHelp: PROC;
  37.     curRP: ReadProc;
  38.     curWP: WriteProc;
  39.     curWLnP: WriteLnProc;
  40.  
  41.   VAR
  42.     readAgainFlag: BOOLEAN;
  43.     
  44.   PROCEDURE Read (VAR ch: CHAR);
  45.   BEGIN
  46.     IF readAgainFlag THEN
  47.       ch := termCH;
  48.       readAgainFlag := FALSE;
  49.     ELSE
  50.       curRP(termCH); ch := termCH;
  51.     END(*IF*);
  52.     Aborted := ch = ESC;
  53.   END Read;
  54.   
  55.   PROCEDURE ReadAgain;
  56.   BEGIN
  57.     readAgainFlag := TRUE;
  58.   END ReadAgain;
  59.  
  60.   
  61.   PROCEDURE Write (ch: CHAR);
  62.     PROCEDURE SysBeep(duration: INTEGER); CODE 0A9C8H;
  63.   BEGIN
  64.     IF ch=BEL THEN
  65.       SysBeep(1);
  66.     ELSE
  67.       curWP(ch);
  68.     END(*IF*);
  69.   END Write;
  70.   
  71.   PROCEDURE WriteLn;
  72.   BEGIN
  73.     curWLnP;
  74.   END WriteLn;
  75.  
  76.   
  77.   
  78.   PROCEDURE ReadString(VAR s: ARRAY OF CHAR); 
  79.     VAR
  80.       ch: CHAR;
  81.       i,wrpos: CARDINAL;
  82.   BEGIN (*ReadString*)
  83.     Done:=TRUE;
  84.     REPEAT Read(ch); UNTIL (ch>" ") OR (ch=ESC) OR (ch=CAN);
  85.     wrpos:=0;
  86.     i:=0;
  87.     LOOP
  88.       IF (ch=DEL) OR (ch=BS) THEN 
  89.         IF i>0 THEN DEC(i); s[i]:=" " END;
  90.         IF wrpos>0 THEN 
  91.           Write(DEL); DEC(wrpos) 
  92.         END(*IF*);
  93.       ELSIF (ch=ESC) OR (ch=CAN) OR (ch<" ") THEN 
  94.         termCH:=ch; Done:=FALSE; EXIT 
  95.       ELSE
  96.         IF i<=HIGH(s) THEN s[i]:=ch END;
  97.         i:=i+1;
  98.         Write(ch); INC(wrpos);
  99.       END(*IF*);
  100.       Read(ch); 
  101.     END(*LOOP*);
  102.     IF i<=HIGH(s) THEN s[i]:=0C END;
  103.   END ReadString;
  104.   
  105.   PROCEDURE ReadInt(VAR x: INTEGER);
  106.     VAR i: INTEGER; n: CARDINAL;
  107.       ch: CHAR; neg: BOOLEAN;
  108.       buf: ARRAY [0..9] OF CHAR;
  109.       
  110.     PROCEDURE next;
  111.     BEGIN ch := buf[n]; n := n+1
  112.     END next;
  113.     
  114.   BEGIN 
  115.     ReadString(buf); n := 0; next;
  116.     WHILE ch = " " DO next END ;
  117.     IF ch = "-" THEN
  118.       neg := TRUE; next
  119.     ELSE neg := FALSE;
  120.       IF ch = "+" THEN next END
  121.     END ;
  122.     IF ("0" <= ch) & (ch <= "9") THEN
  123.       i := 0; Done := TRUE;
  124.       REPEAT i := 10*i + (ORD(ch) - ORD("0")); next
  125.       UNTIL (ch < "0") OR ("9" < ch);
  126.       Done:= Done AND (ch<=" ");
  127.       IF neg THEN x := -i ELSE x := i END
  128.     ELSE Done:= FALSE
  129.     END;
  130.   END ReadInt;
  131.   
  132.   PROCEDURE ReadReal (VAR x: REAL);
  133.     VAR buf: ARRAY [0..25] OF CHAR;
  134.   BEGIN 
  135.     ReadString(buf);
  136.     StringToReal(buf,0,x,Done);
  137.   END ReadReal;
  138.  
  139.   
  140.   PROCEDURE WriteString (s: ARRAY OF CHAR);
  141.     VAR i,n: INTEGER;
  142.   BEGIN
  143.     i:= 0; n:= HIGH(s);
  144.     WHILE (i<=n) AND (s[i]<>0C) DO
  145.       Write(s[i]); INC(i);
  146.     END(*WHILE*);
  147.   END WriteString;
  148.  
  149.   
  150.   PROCEDURE WriteInt(x: LONGINT; n: CARDINAL);
  151.     VAR i: CARDINAL; dig: INTEGER; x0: LONGINT;
  152.       a: ARRAY [0..12] OF CHAR;
  153.   BEGIN 
  154.     i := 0; x0 := ABS(x);
  155.     REPEAT
  156.       dig := x0 MOD 10D; dig := dig + 60B;
  157.       a[i] := CHR(dig);
  158.       x0 := x0 DIV 10D; i := i+1
  159.     UNTIL x0 = 0D;
  160.     IF x < 0D THEN a[i] := "-"; i := i+1 END ;
  161.     WHILE n > i DO
  162.       n := n-1; Write(" ")
  163.     END ;
  164.     REPEAT i := i-1; Write(a[i]) UNTIL i = 0
  165.   END WriteInt;
  166.   
  167.   PROCEDURE WriteReal (x: REAL; n,dec: CARDINAL);
  168.     VAR buf: ARRAY [0..80] OF CHAR; VAR dummyOk: BOOLEAN;
  169.   BEGIN
  170.     RealToFixString (x,dec,n,buf,dummyOk); (* should automatically
  171.     convert to exponential representation if number too large *)
  172.     WriteString(buf);
  173.   END WriteReal;
  174.  
  175.  
  176.   PROCEDURE Wait;
  177.     CONST t = "To continue hit a key";
  178.     VAR ch: CHAR;
  179.   BEGIN
  180.     IF RandomWriteDisplay THEN
  181.       (*. IF Row=maxRow THEN (*insert a line*) WriteLn END;
  182.       Write(BEL); moveCursor(maxRow,(maxCol-25(*length of t*)) DIV 2);
  183.       reverseOn; blinkingOn; 
  184.       WriteString(t); Write(BS); 
  185.       blinkingOff; reverseOff; 
  186.       Read(ch); moveCursor(Row,1); eraseToEOL;
  187.       epr:=epr-ScrollUps;
  188.       moveCursor(epr,epc); eraseToEOL; moveCursor(epr,1); .*)
  189.     ELSE
  190.       Terminal.WriteString(t); Terminal.WriteString("… "); 
  191.       Read(ch);
  192.     END(*IF RandomWriteDisplay*);
  193.   END Wait;
  194.   
  195.   
  196.   PROCEDURE DefaultGiveHelp;
  197.     CONST t = "no help information available";
  198.     VAR ch: CHAR;
  199.   BEGIN
  200.     IF RandomWriteDisplay THEN
  201.       (*. IF Row=maxRow THEN (*insert a line*) WriteLn END;
  202.       Write(BEL); moveCursor(maxRow,(maxCol-29(*length of t*)) DIV 2);
  203.       reverseOn; blinkingOn; 
  204.       WriteString(t); Write(BS); 
  205.       blinkingOff; reverseOff; 
  206.       Read(ch); moveCursor(Row,1); eraseToEOL;
  207.       epr:=epr-ScrollUps;
  208.       moveCursor(epr,epc); eraseToEOL; moveCursor(epr,1); .*)
  209.     ELSE
  210.       WriteLn;
  211.       WriteString(t);
  212.       WriteLn;
  213.     END(*IF RandomWriteDisplay*);
  214.   END DefaultGiveHelp;
  215.   
  216.   PROCEDURE InstallGiveHelpProc (hp: PROC);
  217.   BEGIN
  218.     curGiveHelp := hp;
  219.   END InstallGiveHelpProc;
  220.   
  221.   
  222.  
  223.   CONST
  224.     askKeyStringLength=3;
  225.   
  226.   TYPE
  227.     askKeyString=ARRAY[0..askKeyStringLength-1] OF CHAR;
  228.   
  229.   VAR
  230.     yes,no: askKeyString;
  231.  
  232.   
  233.   PROCEDURE Ask(question: ARRAY OF CHAR; VAR affirmation: BOOLEAN);
  234.     VAR
  235.       i: CARDINAL;
  236.       s: askKeyString; les: CARDINAL; 
  237.       sofarOK: BOOLEAN;
  238.       ch: CHAR;
  239.   BEGIN (*Ask*)
  240.     LOOP
  241.       WriteString(question); 
  242.       (* random screen not supported: epr:=Row; epc:=Col; ScrollUps:=0; *)
  243.       Read(termCH); 
  244.       IF termCH=EOL THEN
  245.         affirmation:=FALSE; Aborted:=FALSE; 
  246.         WriteString(no); EXIT
  247.       ELSE
  248.         ReadAgain; 
  249.         ReadString(s); (*s must be terminated by 0C if shorter than HIGH(s)*)
  250.         IF termCH=ESC THEN 
  251.           WriteString("<ESC>"); 
  252.           affirmation:=FALSE; 
  253.           Aborted:=TRUE;
  254.           EXIT 
  255.         ELSIF termCH=CAN THEN 
  256.           WriteString(" - cancelled!"); WriteLn; Wait;
  257.         ELSE
  258.           sofarOK:=TRUE;
  259.           i:=0;
  260.           WHILE (i<=askKeyStringLength-1) AND (s[i]<>0C) DO
  261.             ch:=CAP(s[i]);
  262.             sofarOK:=sofarOK AND ((ch=yes[i]) OR (ch=no[i]));
  263.             INC(i);
  264.           END(*WHILE*);
  265.           les:=i;
  266.           IF sofarOK THEN
  267.             affirmation:=CAP(s[0])="Y";
  268.             FOR i:=les TO askKeyStringLength-1 DO
  269.               IF affirmation 
  270.                 THEN Write(yes[i])
  271.                 ELSE Write(no[i])
  272.               END(*IF*)
  273.             END(*FOR*);
  274.             Aborted:=FALSE;
  275.             EXIT
  276.           ELSE
  277.             Write(BEL); 
  278.             WriteString(" --- illegal answer! Try 'y(es)' or 'n(o)'!"); 
  279.             WriteLn; Wait;
  280.           END(*IF sofarOK*);
  281.         END(*IF termCH=ESC*);
  282.       END(*IF first char entered = EOL*);
  283.     END(*LOOP*);
  284.   END Ask;
  285.   
  286.   
  287.   PROCEDURE PromptForChars(p: ARRAY OF CHAR; chs: ARRAY OF CHAR;
  288.                           VAR ch: CHAR);
  289.  
  290.     VAR s: ARRAY [0..2] OF CHAR;
  291.     PROCEDURE InChs(ch: CHAR): BOOLEAN;
  292.       VAR i,n: CARDINAL; q: BOOLEAN;
  293.     BEGIN
  294.       i:=0; n:=HIGH(chs);
  295.       WHILE i<=n DO IF ch=chs[i] THEN RETURN TRUE ELSE INC(i) END END;
  296.       RETURN FALSE;
  297.     END InChs;
  298.     
  299.   BEGIN (*PromptForChars*)
  300.     REPEAT
  301.       WriteString(p); 
  302.       (* random screen not supported: epr:=Row; epc:=Col; ScrollUps:=0; *)
  303.       ReadString(s);
  304.       IF NOT Done THEN
  305.         IF termCH=ESC THEN
  306.           WriteString("<ESC>"); Aborted:= TRUE; WriteLn;
  307.         ELSIF termCH=CAN THEN
  308.           WriteString(" - cancelled"); WriteLn; Wait; Aborted:=FALSE;
  309.         ELSE
  310.           Write(BEL); WriteString(" --- error occured: ");
  311.           WriteString("tried to read past end of file");
  312.           WriteLn; Aborted:=TRUE;
  313.         END(*IF ESC*);
  314.       ELSE
  315.         Aborted:=FALSE; ch:=s[0];
  316.         IF InChs(ch) THEN
  317.           (*RETURN with ch*)
  318.         ELSIF ch=HELP THEN curGiveHelp
  319.         ELSE
  320.           Write(BEL); 
  321.           WriteString(" --- out of range; press one of ");
  322.           Write("'"); WriteString(chs); Write("'"); WriteLn; Wait;
  323.           Done:=FALSE; 
  324.         END(*IF valid range*);
  325.       END(*IF not eof*);
  326.     UNTIL Done OR Aborted;
  327.     curGiveHelp:=DefaultGiveHelp;
  328.   END PromptForChars;
  329.  
  330.  
  331.   PROCEDURE PromptForInt(p: ARRAY OF CHAR; min,max: INTEGER; VAR x: INTEGER);
  332.   BEGIN (*PromptForInt*)
  333.     REPEAT
  334.       WriteString(p); 
  335.       (* random screen not supported: epr:=Row; epc:=Col; ScrollUps:=0; *)
  336.       ReadInt(x); 
  337.       IF NOT Done THEN
  338.         IF termCH=ESC THEN
  339.           WriteString("<ESC>"); Aborted:= TRUE; WriteLn;
  340.         ELSIF termCH=CAN THEN
  341.           WriteString(" - cancelled"); WriteLn; Wait;
  342.         ELSIF termCH=HELP THEN
  343.           curGiveHelp
  344.         ELSE
  345.           Write(BEL); WriteString(" --- illegal number; enter INTEGER");
  346.           WriteLn; Wait;
  347.         END(*IF ESC*);
  348.       ELSE
  349.         Aborted:=FALSE;
  350.         IF (min<=x) AND (x<=max) THEN
  351.           (*RETURN with x*)
  352.         ELSE
  353.           Write(BEL); 
  354.           WriteString(" --- out of range; enter number within ");
  355.           WriteInt(min,0); WriteString(".."); WriteInt(max,0); WriteLn;
  356.           Wait; Done:=FALSE; 
  357.         END(*IF valid range*);
  358.       END(*IF legal INTEGER*);
  359.     UNTIL Done OR Aborted;
  360.     curGiveHelp:=DefaultGiveHelp;
  361.   END PromptForInt;
  362.  
  363.  PROCEDURE PromptForReal(p: ARRAY OF CHAR; min,max: REAL; VAR x: REAL);
  364.   BEGIN (*PromptForReal*)
  365.     REPEAT
  366.       WriteString(p); 
  367.       (* random screen not supported: epr:=Row; epc:=Col; ScrollUps:=0; *)
  368.       ReadReal(x);
  369.       IF NOT Done THEN
  370.         IF termCH=ESC THEN
  371.           WriteString("<ESC>"); Aborted:= TRUE; WriteLn;
  372.         ELSIF termCH=CAN THEN
  373.           WriteString(" - cancelled"); WriteLn; Wait;
  374.         ELSIF termCH=HELP THEN 
  375.           curGiveHelp
  376.         ELSE
  377.           Write(BEL); WriteString(" --- illegal number; enter REAL");
  378.           WriteLn; Wait;
  379.         END(*IF ESC*);
  380.       ELSE (*Done=TRUE*)
  381.         Aborted:=FALSE;
  382.         IF (min<=x) AND (x<=max) THEN
  383.           (*RETURN with x*)
  384.         ELSE
  385.           Write(BEL); 
  386.           WriteString(" --- out of range; enter number within ");
  387.           WriteReal(min,0,5); WriteString(".."); WriteReal(max,0,5); WriteLn; 
  388.           Wait; Done:=FALSE; 
  389.         END(*IF valid range*);
  390.       END(*IF legal REAL*);
  391.     UNTIL Done OR Aborted;
  392.     curGiveHelp:=DefaultGiveHelp;
  393.   END PromptForReal;
  394.  
  395.   PROCEDURE InstallReadProc  (rp: ReadProc);
  396.   BEGIN
  397.     curRP := rp;
  398.   END InstallReadProc;
  399.   
  400.   PROCEDURE InstallWriteProc (wp: WriteProc);
  401.   BEGIN
  402.     curWP := wp;
  403.   END InstallWriteProc;
  404.   
  405.   PROCEDURE InstallWriteLnProc (wlnp: WriteLnProc);
  406.   BEGIN
  407.     curWLnP := wlnp
  408.   END InstallWriteLnProc;
  409.   
  410.  
  411. BEGIN
  412.   termCH:= " "; Done:=FALSE; Aborted:=FALSE;
  413.   yes:="YES"; no:="NO ";
  414.   curRP := Terminal.Read;
  415.   curWP := Terminal.Write;
  416.   curWLnP := Terminal.WriteLn;
  417.   curGiveHelp:=DefaultGiveHelp;
  418.   (* no random, i.e. cursor controlled, screen output 
  419.   supported in current implementation: *) 
  420.   RandomWriteDisplay := FALSE;
  421. END HighInOut .
  422.